home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / disklib.arc / DISKLIB.BAS (.txt)
Encoding:
GW-BASIC  |  1985-08-24  |  5.9 KB  |  184 lines

  1. 10  REM ************ DISK LIBRARIAN ***************
  2. 20  REM **** VERSION 1.1  REDONE BY AL STOUT ******
  3. 30  REM ************** 12-19-82 *******************
  4. 31  '
  5. 32  '===============6/19/83=====DAVE SCHNEIDER============
  6. 33  '
  7. 34  '   CHANGED LINE 1520 TO CHR$(15)  FOR C.ITOH PRINTER! [WAS CHR$(15)
  8. 35  'MAKE SURE DEFAULT DRIVE IS "A"
  9. 36  '
  10. 40  CLS
  11. 41  COLOR 15,0
  12. 42  PRINT CHR$(201)+STRING$(70,205)+CHR$(187)
  13. 50  PRINT CHR$(186)+STRING$(70,32)+CHR$(186)
  14. 60  PRINT CHR$(186);"     THIS PROGRAM READS THE DIRECTORYS OF DISKETTES AND PUTS THEM     ";CHR$(186)
  15. 70  PRINT CHR$(186);"     TO A WORK FILE ON DRIVE B.  IT THEN SORTS IN ALPHA ORDER AND     ";CHR$(186)
  16. 80  PRINT CHR$(186);"     PRINTS A CATALOG OF ALL FILES AND THEIR RESPECTIVE DISK NAME.    ";CHR$(186)
  17. 90  PRINT CHR$(186);"     USE A WORK DISK OR ONE THAT YOU DONT WANT INCLUDED IN THE        ";CHR$(186)
  18. 100  PRINT CHR$(186);"     CATALOG. YOU MAY REMOVE ONE DISK AND INSERT ANOTHER AS SOON      ";CHR$(186)
  19. 110  PRINT CHR$(186);"     AS THE RED LIGHT GOES OUT ON THE A DRIVE. ENTER AS MANY DISKS    ";CHR$(186)
  20. 120  PRINT CHR$(186);"     AS YOU WISH UP TO 800 SEPERATE FILES.                            ";CHR$(186)
  21. 122  PRINT CHR$(186)+STRING$(70,32)+CHR$(186)
  22. 123  PRINT CHR$(200)+STRING$(70,205)+CHR$(188)
  23. 125  COLOR 7
  24. 130  PRINT
  25. 140  PRINT "INSERT WORK DISK IN B IF NOT ALREADY DONE"
  26. 150  PRINT
  27. 160  PRINT
  28. 170  PRINT "LIST IN ORDER BY (F)ILE OR (D)ISK ?";
  29. 180  SEQ$=INKEY$ : IF SEQ$ = "" THEN 180
  30. 190  IF SEQ$ = "D" OR SEQ$ = "d" THEN SE = 1
  31. 200  IF SE = 1 THEN XXX$ = "DISK" ELSE XXX$ = "FILE"
  32. 210  IF SE = 1 THEN YYY$ = "FILE" ELSE YYY$ = "DISK"
  33. 220  DEFINT I,J,K,L,N
  34. 230  DIM ARRA$(64)
  35. 240  SKP = 0 'SWITCH TO PRINT ALIGN PAPER ONLY ONCE
  36. 250  P=1     'PAGE NUMBER
  37. 260  OPEN "B:DATA" FOR OUTPUT AS #1
  38. 270  CLS:PRINT "ENTER NAME OF DISK IN DRIVE A OR END"
  39. 280  PRINT " <-------->"
  40. 290  LOCATE 15,1 : PRINT N1,"FILES READ" : LOCATE 3,1
  41. 300  INPUT;DNAM$
  42. 310  CLS
  43. 320  IF DNAM$="END" OR DNAM$="end" THEN GOTO 720 ELSE 440
  44. 330  CLS:PRINT "DO YOU WANT TO LIST IN ";YYY$;" SEQUENCE, (Y) OR (N) ?";
  45. 340  CH$=INKEY$ : IF CH$="" THEN 340
  46. 350  IF CH$="Y" OR CH$="y" THEN 370
  47. 360  END
  48. 370  ERASE ARRAY$ :FC = FCP
  49. 380  ERASE S.SP%: CLOSE #1: P = 1
  50. 390  ERASE AR$,FL$,DSK$ : SKP = 1 : SKIP = 0
  51. 400  IF SE=0 THEN SE=1 ELSE SE=0
  52. 410  IF SE=1 THEN XXX$="DISK" ELSE XXX$="FILE"
  53. 420  IF SE=1 THEN YYY$="FILE" ELSE YYY$="DISK"
  54. 430  GOTO 740
  55. 440  CLS
  56. 450  FILES
  57. 460  DEF SEG = &HB000
  58. 470  N=1
  59. 480  FOR I=0 TO 1600 STEP 160
  60. 490  FOR J=0 TO 130 STEP 26
  61. 500  FILEBILD$ = ""
  62. 510  L = I+J
  63. 520  FOR K=0 TO 24 STEP 2
  64. 530  FILEBILD$ = FILEBILD$ + CHR$(PEEK(K+L))
  65. 540  NEXT K
  66. 550  IF LEFT$(FILEBILD$,1) = " " THEN 610
  67. 560  ARRA$(N) = FILEBILD$
  68. 570  N = N+1
  69. 580  FILEBILD$ = ""
  70. 590  NEXT J
  71. 600  NEXT I
  72. 610  N=N-1
  73. 620  N1=N1+N
  74. 630  GOSUB 650
  75. 640  GOTO 270
  76. 650  REM write array to file
  77. 660  FOR I = 1 TO N
  78. 670  PRINT #1,USING "\                   \";ARRA$(I)+DNAM$
  79. 680  ARRA$(I)=""
  80. 690  NEXT I
  81. 700  FC=FC+N
  82. 710  RETURN
  83. 720  CLOSE #1
  84. 730  FCP=FC
  85. 740  REM This example sorts "ARRAY$" in ascending order
  86. 750  DIM ARRAY$(FCP)
  87. 760  OPEN "B:DATA " FOR INPUT AS #1
  88. 770  FOR I = 1 TO FCP
  89. 780  IF SE = 1 THEN 810
  90. 790  INPUT#1,ARRAY$(I)
  91. 800  IF SE = 0 THEN 830
  92. 810  INPUT#1,REV$
  93. 820  ARRAY$(I) = MID$(REV$,14,8)+MID$(REV$,1,13)
  94. 830  NEXT I
  95. 840  GOSUB 900 ' Call to sort subroutine
  96. 850  PRINT "SORT COMPLETE                    " TIME$
  97. 860  GOTO 1060
  98. 870  REM *******************************************
  99. 880  REM ********* QUICKER SORT SUBROUTINE *********
  100. 890  REM *********                         *********
  101. 900  S.AL% = FCP ' Limit of array to be sorted **** REQUIRED FOR SORT ****
  102. 910  CLS:PRINT "SORT STARTED ...STAND BY         " TIME$
  103. 920  DIM S.SP%(CINT(LOG(S.AL%)/0.346574),2) 'If sort is to be called more than once, `DIM' the stack `S.SP%' for the largest size of the array outside the sort
  104. 930  S.IS% = 0: S.LL% = 1: S.UL% = S.AL%: GOTO 990
  105. 940  SWAP ARRAY$(S.SL%),ARRAY$(S.LL%):IF S.SL% > S.UL%-2 THEN S.UL% = S.SL%-1 ELSE IF S.SL% < S.LL%+2 THEN S.LL% = S.LL%+1 ELSE S.IS% = S.IS%+1: S.SP%(S.IS%,1)=S.LL%: S.SP%(S.IS%,2) = S.SL%-1: S.LL%=S.SL%+1
  106. 950  GOTO 990
  107. 960  FOR S.I1% = S.LL% + 1 TO S.UL%: FOR S.I2% = S.LL% TO S.I1%: IF ARRAY$(S.I1%) < ARRAY$(S.I2%) THEN SWAP ARRAY$(S.I1%),ARRAY$(S.I2%)
  108. 970  NEXT S.I2%: NEXT S.I1%
  109. 980  IF S.IS% = 0 THEN RETURN ELSE S.LL% = S.SP%(S.IS%,1): S.UL%=S.SP%(S.IS%,2): S.IS% = S.IS%-1
  110. 990  IF S.UL% - S.LL% <= 9 THEN 960 ELSE S.LS% = S.LL%: S.US% = S.UL% + 1: SWAP ARRAY$(S.LL%),ARRAY$(INT((S.US%-S.LS%)/2)+S.LL%)
  111. 1000  IF S.US% = S.LS%+1 THEN S.SL% = S.LS%: GOTO 940 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 1020
  112. 1010  IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%-1: GOTO 940 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 1010 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 1000
  113. 1020  IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%: GOTO 940 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 1000
  114. 1030  IF S.US% = S.LS% + 1 THEN S.SL% = S.US%: GOTO 940 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 1030 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 1020
  115. 1040  END '******** End of quicker sort subroutine **
  116. 1050  REM *******************************************
  117. 1060  REM WRITE CATALOG FILE AND PRINT
  118. 1070  DIM AR$(100),FL$(100),DSK$(100)
  119. 1080  IF FCP> 100 THEN 1170
  120. 1090  FCX = FCP
  121. 1100  FOR Y = 1 TO FC
  122. 1110  AR$(Y) = ARRAY$(Y)
  123. 1120  ARRAY$(Y) = " "
  124. 1130  NEXT Y
  125. 1140  GOSUB 1360
  126. 1150  LPRINT CHR$(12) : SKIP = 0
  127. 1160  GOTO 330
  128. 1170  X = 0
  129. 1180  FOR Y= 1 TO 100
  130. 1190  AR$(Y) = ARRAY$(Y+X)
  131. 1200  ARRAY$(Y+X) = " "
  132. 1210  NEXT Y
  133. 1220  X = X + 100
  134. 1230  FCX = 100
  135. 1240  GOSUB 1360
  136. 1250  LPRINT CHR$(12) : SKIP = 0
  137. 1260  FC = FC - 100
  138. 1265  ERASE AR$,FL$,DSK$
  139. 1266  DIM AR$(100),FL$(100),DSK$(100)
  140. 1270  IF FC > 100 THEN 1180
  141. 1280  FOR Y= 1 TO FC
  142. 1290  AR$(Y) = ARRAY$(Y+X)
  143. 1300  ARRAY$(Y+X) = " "
  144. 1310  NEXT Y
  145. 1320  FCX = FC
  146. 1330  GOSUB 1360
  147. 1340  LPRINT CHR$(12) : SKIP = 0
  148. 1350  GOTO 330
  149. 1360  FOR I = 1 TO FCX
  150. 1370  IF SE = 1 GOTO 1400
  151. 1380  FL$(I)=MID$(AR$(I),1,12): DSK$(I)=MID$(AR$(I),14,8)
  152. 1390  GOTO 1410
  153. 1400  DSK$(I)=MID$(AR$(I),1,8): FL$(I)=MID$(AR$(I),9,12)
  154. 1410  NEXT I
  155. 1420  IF SKP = 1 THEN 1470
  156. 1430  CLS:LOCATE 15,15
  157. 1440  PRINT "ALIGN PAPER FOR OUTPUT, PRESS ANY KEY TO PRINT"
  158. 1450  SKP = 1
  159. 1460  Z$ = INKEY$: IF Z$ = "" THEN 1460
  160. 1470  K=FCX/2
  161. 1480  FOR I=0 TO K-1
  162. 1490  FOR J=1 TO FCX STEP K
  163. 1500  IF SKIP = 1 GOTO 1600
  164. 1510  LPRINT CHR$(14); STRING$(6,32)+"DISK LIBRARY"+STRING$(4,32)+DATE$
  165. 1520  LPRINT CHR$(15)
  166. 1530  LPRINT TAB(25) "SEQUENCED BY ";XXX$ TAB(56) "PAGE ";P
  167. 1540  LPRINT
  168. 1550  LPRINT TAB(7) XXX$ TAB(23) YYY$ TAB(41) XXX$ TAB(57) YYY$
  169. 1560  LPRINT STRING$(66,163)
  170. 1570  LPRINT CHR$(27);"F"
  171. 1580  P=P+1
  172. 1590  SKIP = 1
  173. 1600  IF SE = 1 THEN 1630
  174. 1610  LPRINT USING "  \             \";FL$(I+J);DSK$(I+J);
  175. 1620  GOTO 1660
  176. 1630  IF DSK$(I+J) = DSK$((I+J)-1) THEN DK$ = " " ELSE DK$ = DSK$(I+J)
  177. 1640  LPRINT USING "  \             \";DK$;FL$(I+J);
  178. 1650  DK$ = ""
  179. 1660  NEXT J
  180. 1670  LPRINT
  181. 1680  NEXT I
  182. 1690  RETURN
  183. 65399  '** DONE - PRESS ENTER TO RETURN TO MENU **
  184.